home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr10 / tvprompt.zip / SCREEN.PKG < prev    next >
Text File  |  1992-05-29  |  4KB  |  106 lines
  1. with Calendar,
  2.      CRT,
  3.      Letters;
  4.  
  5. package body Screen is
  6. -- Copyright 1992 Tom Moran
  7.  
  8.   Leading : constant:=1; -- number of blank scan lines between lines of text
  9.  
  10.   task body Scroller is
  11.     Time_Per_Line: Duration
  12.       := Initial_Scroll_Passage_Time / CRT.Logical_Screen_Height;
  13.     Next_Scroll_Time: Calendar.Time := Calendar.Clock;
  14.     Appearing_String: Scrollable_Strings;
  15.     Background_Is_Black: Boolean;
  16.     Text_Height: constant integer := Letters.Pattern'length(2)+Leading;
  17.     subtype Text_Lines is integer range 0 .. Text_Height;
  18.     Text_Line       : Text_Lines := Text_Lines'last;
  19.     Next_Scan_Line  : CRT.Full_Scan_Lines := (others => CRT.White);
  20.     Single_Byte     : Letters.Byte_Bit_Pairs;
  21.     -- note that two bits in letter pattern expand into 8 on screen to
  22.     -- give big enough characters to read on the teleprompter
  23.     Show_Bit_Pair: constant array (Letters.Bit_Pairs) of CRT.Bytes
  24.       := (0 => 16#FF#, 1 => 16#F0#, 2 => 16#0F#, 3 => 16#00#);
  25.     Reversed_Show_Bit_Pair: constant array (Letters.Bit_Pairs) of CRT.Bytes
  26.       := (0 => 16#00#, 1 => 16#0F#, 2 => 16#F0#, 3 => 16#FF#);
  27.  
  28.     function "+" (Left  : in Calendar.Time;
  29.                   Right : in Duration) return Calendar.Time
  30.       renames Calendar."+";
  31.  
  32.     function "-" (Left, Right : in Calendar.Time) return Duration
  33.       renames Calendar."-";
  34.  
  35.   begin
  36.     accept Start_Up;
  37.  
  38.     CRT.Open_White_Screen;
  39.     Next_Scroll_Time := Calendar.Clock + Time_Per_Line;
  40.  
  41.     Until_Told_Otherwise:
  42.     loop
  43.       -- we can accept Adjust_Speed or Wind_Up anytime
  44.       -- we will accept Put(string) anytime we are not still busy
  45.       -- rolling a previous string onto the screen.
  46.       -- if no external requests for action, we scroll lines onto the
  47.       -- screen and scroll the screen up at the desired rate
  48.       select
  49.         accept Adjust_Speed(Scroll_Passage_Time: in Duration) do
  50.           Time_Per_Line := Scroll_Passage_Time / CRT.Logical_Screen_Height;
  51.         end;
  52.       or
  53.         when Text_Line = Text_Height =>
  54.           accept Put(S             : in Scrollable_Strings;
  55.                      White_On_Black: in Boolean := False) do
  56.             Appearing_String := S;
  57.             Background_Is_Black := White_On_Black;
  58.           end;
  59.           Text_Line := 0;
  60.       or
  61.         accept Wind_Up;
  62.         CRT.Revert_To_Text;
  63.         exit;
  64.       or
  65.         delay Next_Scroll_Time - Calendar.Clock;
  66.         if Time_Per_Line = 0.0 then
  67.           -- paused
  68.           Next_Scroll_Time := Calendar.Clock + Time_Per_Line;
  69.         else
  70.           Next_Scroll_Time := Next_Scroll_Time + Time_Per_Line;
  71.           CRT.Scroll(Next_Scan_Line);
  72.           if Text_Line < Text_Height then
  73.             if Text_Line > Letters.Line_Numbers'last then
  74.               Next_Scan_Line := (Next_Scan_Line'range => CRT.White);
  75.             else -- we're in a letter: make scan line from letter patterns
  76.               declare
  77.                 X : Integer:=Next_Scan_Line'first;
  78.               begin
  79.                 for J in Appearing_String'range loop
  80.                   Single_Byte
  81.                     := Letters.Pattern(Appearing_String(J),Text_Line);
  82.                   if Background_Is_Black then
  83.                     Next_Scan_Line(X)  :=Reversed_Show_Bit_Pair(Single_Byte.A);
  84.                     Next_Scan_Line(X+1):=Reversed_Show_Bit_Pair(Single_Byte.B);
  85.                     Next_Scan_Line(X+2):=Reversed_Show_Bit_Pair(Single_Byte.C);
  86.                     Next_Scan_Line(X+3):=Reversed_Show_Bit_Pair(Single_Byte.D);
  87.                   else
  88.                     Next_Scan_Line(X)   := Show_Bit_Pair(Single_Byte.A);
  89.                     Next_Scan_Line(X+1) := Show_Bit_Pair(Single_Byte.B);
  90.                     Next_Scan_Line(X+2) := Show_Bit_Pair(Single_Byte.C);
  91.                     Next_Scan_Line(X+3) := Show_Bit_Pair(Single_Byte.D);
  92.                   end if;
  93.                   X:=X+4;
  94.                 end loop;
  95.               end;
  96.             end if;
  97.             Text_Line := Text_Line + 1;
  98.           end if;
  99.         end if;
  100.       end select;
  101.     end loop Until_Told_Otherwise;
  102.  
  103.   end Scroller;
  104.  
  105. end Screen;
  106.